xquery version "1.0-ml";
module namespace json="http://jqstore.org/json";
declare namespace xdmp="http://marklogic.com/xdmp";
declare option xdmp:mapping "false";

(: ===================================================================================================== :)
(: These functions take any JSON and turn it into JSONXML that can be round tripped back to JSON exactly as original :)

declare function json:json2xml ($str as xs:string) { json:_json2xml ($str) };
declare function json:xml2json($items as item()*) as xs:string { json:_xml2json($items,fn:false(),()) };
declare function json:xml2jsonPretty($items as item()*) as xs:string { json:_xml2json($items,$pretty,()) };

(: ===================================================================================================== :)
(: These functions take dxml (see below) and round trip it to JSON and back. :)

declare function json:dxml2json ($node as node(), $pretty as xs:boolean) { json:dxml2json ($node, $pretty, ()) };
declare function json:dxml2json ($node as node(), $pretty as xs:boolean, $arrays as xs:string*) {
	json:_xml2json( element o { json:dxml2jsonxmlTransform($node, $arrays) }, $pretty, 0)
};
declare function json:json2dxml($str as xs:string) { json:jsonxml2dxmlTransform(json:json2xml($str)) };

(:
	Rules for dxml (DataXML):
	1. dxml elements cannot have text if it has attributes or elements in it, text must be an only child.
	2. elements of same name will be grouped as an array in the json and elements may be rearranged
		in order, maintaining order within element type.
	3. dxml2json can be passed a sequence of names of elements that should be generated into JSON arrays.
	4. an attribute like json-arrays="wam,preferredName" can be added to some dxml to identify element as in 3.
	5. current version does not support dxml with namespaced elements and attributes.
:)

(: ===================================================================================================== :)
(: These functions can be used as "constructors" along with to json:xml2json to programmatically create JSON :)

declare function json:o($items) {  json:_object($items) };
declare function json:m($name,$items as item()*) { json:_member($name,$items) };
declare function json:a($items as item()*) { json:_array($items) };
declare function json:v($item) { json:_value($item) };

(: The rest is private implementation ======================================================================== :)

declare private function json:_json2xml ($str) {
	(: hide the escaping so parsing can be easier :)
	let $str := fn:replace(fn:replace($str,'\\\\','\\u005c'),'\\"','\\u0022')
	let $stuff :=
		for $x at $i in fn:tokenize($str,'"')
		return
			if($i mod 2 eq 1)
			then (: outside a string :)
				let $x := fn:replace($x,'\{','<o>')
				let $x := fn:replace($x,'\}','</o>')
				let $x := fn:replace($x,'\[','<a>')
				let $x := fn:replace($x,'\]','</a>')
				let $x := fn:replace($x,'true','<b>true</b>')
				let $x := fn:replace($x,'false','<b>false</b>')
				let $x := fn:replace($x,'null','<null/>')
				let $x := fn:replace($x,',','')
				let $x := fn:replace($x,':','')
				let $x := fn:replace($x,'\s','')
				return $x
			else (: inside a string :)
				let $x := fn:replace($x,'\\u0022','"')
				let $x := fn:replace($x,'\\u005c','\\\\')
				let $x := element s { $x }
				let $x :=xdmp:quote($x)
				return $x
	let $xml := xdmp:unquote(fn:string-join(('<!DOCTYPE [<!ENTITY quot &#34;><!ENTITY copy "&#38;">]> ',$stuff),''),'')
	let $xml2 := json:transform($xml/*)
	return $xml2
};

declare private function json:transform($node)
{
	typeswitch($node)
		case element(o) return
			let $list := $node/node()
			return element o {
				for $x at $i in $list
					return
						if(($i mod 2) = 1)
						then element m { attribute n { fn:string($list[$i]) }, json:transform($list[$i + 1]) }
						else ()
			}
		case element(a) return element a { for $n in $node/node() return json:transform($n) }
		case element(null) return $node
		case element(s) return $node
		case element(b) return $node
		case text() return element n { $node }
		default return ()
};

declare private function json:_xml2json($items as item()*) as xs:string {
	for $item in $items
	return
		typeswitch($item)
			case element(a)
				return fn:concat('[',fn:string-join(for $i in $item/* return json:_xml2json($i),','),']')
			case element(o)
				return fn:concat('{',fn:string-join(for $i in $item/* return json:_xml2json($i),','),'}')
			case element(m)
				return
					let $name := fn:string($item/@n)
					return fn:concat(
						'"',$name,'":',
						fn:string-join(for $i in $item/* return json:_xml2json($i),',')
					)
			case element(s)
				return fn:concat('"',fn:replace( fn:replace( $item, '\n', '\\n' ), '&quot;', '\\&quot;' ), '"')
			case element(null)
				return 'null'
			default
				return fn:string($item)
};

declare private function json:nl($pretty as xs:boolean, $indent) { if($pretty) then fn:string-join(($nl,for $i in 1 to $indent return $tab),'') else "" };

declare private function json:_xml2json($items as item()*, $pretty as xs:boolean, $indent) as xs:string {
	for $item in $items
	return
			typeswitch($item)
				case element(a)
					return fn:concat('[',json:nl($pretty, $indent),fn:string-join(for $i in $item/* return json:_xml2json($i,$pretty,$indent + 1),fn:concat(',',json:nl($pretty, $indent))),json:nl($pretty, $indent - 1),']')
				case element(o)
					return fn:concat('{',fn:string-join(for $i in $item/* return json:_xml2json($i,$pretty,$indent + 1),','),json:nl($pretty, $indent - 1),'}')
				case element(m)
					return
						let $name := fn:string($item/@n)
						return fn:concat(json:nl($pretty, $indent),
							'"',$name,'":',
							fn:string-join(for $i in $item/* return json:_xml2json($i,$pretty,$indent + 1),',')
						)
				case element(s)
					return fn:concat('"', fn:replace( fn:replace( $item, '\n', '\\n' ), '&quot;', '\\&quot;' ), '"')
				case element(null)
					return 'null'
				default
					return fn:string($item)
};

declare private function json:_object($items) { element o { $items } };

declare private function json:_member($n,$items)
{
	element m {
		attribute n { $n },
		if(fn:count($items) > 1)
		then element a { for $item in $items return json:_value($item) }
		else json:value($items)
	}
};

declare private function json:_array($items) { element a { $items } };

declare private function json:_value($item)
{
		if(fn:exists($item))
		then
			typeswitch($item)
				case xs:string
					return element s { $item }
				case xs:integer
					return element n { $item }
				case xs:boolean
					return element b { $item }
				default
					return $item
		else ()
};

declare private function json:valueFromText($str)
{
		if($str = 'yes' or $str = 'true') then element b { 'true' }
		else if($str = 'no' or $str = 'false') then element b { 'false' }
		else if($str = 'null') then element null {}
		else element s { $str }
};

declare private function json:elementInnards($node,$arrays) {
	for $attr in $node/@*
	let $name := fn:concat('_',fn:local-name($attr))
	return
		(: put in attributes :)
		if($name = '_json-arrays') then
			let $set := xdmp:set($arrays,($arrays, for $i in fn:tokenize(fn:string($attr),",") return fn:normalize-space($i)))
			return element m { attribute n { $name }, json:valueFromText(fn:string($attr))}
		else
			element m { attribute n { $name }, json:valueFromText(fn:string($attr))}
	,
		(: put in elements :)
	let $map := map:map()
	let $names := fn:distinct-values(for $n in $node/element() return fn:local-name($n))
	let $compute :=
		for $child in $node/element()
		let $name := fn:local-name($child)
		return map:put($map,$name,element x { map:get($map,$name)/element(), $child})
	return
		for $key in $names
		return
			for $item in map:get($map,$key)
			let $count := fn:count($item/element())
			return
				if($count > 1 or $key = $arrays) then
					element m {
						attribute n { $key },
						element a {
							for $i in $item/element()
	(:						let $x := fn:error():)
							return  json:dxml2jsonxmlTransform($i,$arrays)/node()
						}
					}
				else
					 json:dxml2jsonxmlTransform($item/node(),$arrays)
};

declare private function json:dxml2jsonxmlTransform($node,$arrays) {
	typeswitch($node)
		case element() return
			if(fn:count(($node/@*,$node/element())) > 0) then
					element m {
						attribute n { fn:local-name($node) },
						element o { json:elementInnards($node,$arrays)}
				}
			else
				element m {
					attribute n { fn:local-name($node) },
					json:valueFromText(fn:normalize-space( $node ))
				}
			case text() return json:valueFromText(fn:string($node))
		default return ()
};

declare private function json:jsonxml2dxmlTransform($node) {
	typeswitch($node)
		case element(o) return
				for $child in $node/element()
				return json:jsonxml2dxmlTransform($child)
		case element(m) return
			let $name := fn:data($node/@n)
			let $children :=
				for $child in $node/element()
				return json:jsonxml2dxmlTransform($child)
			return
				if(fn:starts-with($name,"_")) then
					attribute {fn:substring($name,2)}{ $children }
				else
					if($node/a) then $children else element {$name} { $children }
		case element(a) return
			for $child in $node/element()
			return element {fn:data($node/../@n)} { json:jsonxml2dxmlTransform($child) }
		default return $node/text()
};

(: Utility function used to escape any double quotes, backslashes, and newlines
   JSON.org Spec says a valid string is "Any UNICODE character except " or \ or
   control character (including: \b, \f, \n, \r, \t, \uXXXX)
:)
declare function escapeChars($s as xs:string) as xs:string {
	let $s := fn:replace($s, "\\", "\\\\") 								(: lone backslashes :)
	let $s := fn:replace($s, """", "\\""")								(: double quotes :)
	let $s := fn:replace($s, "/", "\\/")								(: forward slash :)
	let $s := fn:replace($s, "\t", "\\t")								(: tabs :)
    let $s := fn:replace($s, fn:codepoints-to-string((13, 10)), "\\n") 	(: \r\n :)
    let $s := fn:replace($s, fn:codepoints-to-string(13), "\\n")  		(: \r :)
    let $s := fn:replace($s, fn:codepoints-to-string(10), "\\n") 		(: \n :)
    return $s
};

(: ===================================================================================================== :)
(: TEST FUNCTIONS :)
declare function json:test-dxml() {
	let $one := json:dxml2json($userxml,fn:true())
	let $two := json:json2dxml($one)
	let $three := json:dxml2json($two,fn:true())
	let $four := json:json2dxml($three)
	return ($one=$three,$two,$one)
};

declare variable $nl := '
';
declare variable $tab := ' ';

declare function json:json() {
	'["hardstring&apos;s &amp;<br/>\"\\\n\n\n",155,{"one":null,"two":[]},true,null,false,{},[]]'
};

declare function json:testdata() {
'
{
 "lastBuildDate": "Thu, 19 May 2011 18:46:54 +0000",
 "version": 1.0,
 "language": "en-us",
 "items": [
	  {
		   "null": null,
		   "startDate": "2011-06-01 00:00:00",
		   "minAge": "",
		   "endDate": "2011-06-01 00:00:00",
		   "contactPhone": "",
		   "quality_score": 0.10000000000000001,
		   "detailUrl": "",
		   "sponsoringOrganizationName": "Latin American Association",
		   "latlong": "33.8291468,-84.345342",
		   "contactName": "",
		   "addr1": "",
		   "impressions": 0,
		   "id": "6d4c74f7d58e087782df2cfb1a1f038f",
		   "city": "",
		   "location_name": "2750 Buford Hwy, Atlanta, GA 30324",
		   "openEnded": false,
		   "pubDate": "",
		   "title": "Youth Summer Academic Program Volunteers",
		   "base_url": "6d4c74f7d58e087782df2cfb1a1f038f",
		   "virtual": false,
		   "provider": "unitedway",
		   "postalCode": "",
		   "groupid": "Ma5b1636c0f72b4fc56d80c769d1bd573",
		   "audienceAge": "",
		   "audienceAll": "",
		   "description": "Volunteers can participate in several activities depending on their availability, interest, and skill sets. Volunteers can serve as Mystery Readers, Career Presenters, Junior Achievement teachers, Friday fieldtrip chaperones, and activity volunteers. The Youth Summer Program is only offered during t",
		   "street1": "",
		   "street2": "",
		   "interest_count": 0,
		   "xml_url": "http://volunteer.truist.com/uwatl/org/opp/10444800054.html#6d4c74f7d58e087782df2cfb1a1f038f",
		   "audienceSexRestricted": "",
		   "startTime": 0,
		   "contactNoneNeeded": "",
		   "categories": [],
		   "contactEmail": "",
		   "skills": "All volunteers must attend a volunteer orientation and complete an application. Orientation dates, along with the application can be found on the LAA***s website. Tagged skills: Arts / Culture, Child Care, Math / Science, Recreational Activities / Sports, Teaching, Tutoring",
		   "country": "",
		   "region": "",
		   "m": "",
		   "url_short": "volunteer.truist.com",
		   "addrname1": "",
		   "s": "",
		   "v": "",
		   "endTime": 0
	  },
	  {
		   "startDate": "2011-06-05 00:00:00",
		   "minAge": "",
		   "endDate": "2011-06-05 00:00:00",
		   "contactPhone": "",
		   "quality_score": 0.10000000000000001,
		   "detailUrl": "",
		   "sponsoringOrganizationName": "Latin American Association",
		   "latlong": "33.8291468,-84.345342",
		   "contactName": "",
		   "addr1": "",
		   "impressions": 0,
		   "id": "760ca96c5891939672fecfc01a4276da",
		   "city": "",
		   "location_name": "2750 Buford Hwy, Atlanta, GA 30324",
		   "openEnded": false,
		   "pubDate": "",
		   "title": "Copa Latina Soccer Tournament Volunteers",
		   "base_url": "760ca96c5891939672fecfc01a4276da",
		   "virtual": false,
		   "provider": "unitedway",
		   "postalCode": "",
		   "groupid": "M9e4a328c6438394c9fe60f8b77b8aebc",
		   "audienceAge": "",
		   "audienceAll": "",
		   "description": "Copa Latina is an exciting day of soccer and family activities, but also an educational event for Latinos about different health and community Services. In the past we have had soccer clinics, face painting, relay races, health information sessions, and access to community resources. Volunteers will",
		   "street1": "",
		   "street2": "",
		   "interest_count": 0,
		   "xml_url": "http://volunteer.truist.com/uwatl/org/opp/10444794007.html#760ca96c5891939672fecfc01a4276da",
		   "audienceSexRestricted": "",
		   "startTime": 0,
		   "contactNoneNeeded": "",
		   "categories": [],
		   "contactEmail": "",
		   "skills": "All volunteers must attend a volunteer orientation and complete an application. The orientation dates, along with the application can be found on the LAA***s website.",
		   "country": "",
		   "region": "",
		   "m": "",
		   "url_short": "volunteer.truist.com",
		   "addrname1": "",
		   "s": "",
		   "v": "",
		   "endTime": 0
	  }
],
 "href": "http://www.allforgood.org/api/volopps?key=LDSChurch&amp;vol_loc=Atlanta,GA&amp;num=999&amp;output=json",
 "description": "All for Good search results"
}
'
};

